home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 5 / Amiga Tools 5.iso / tools / developer-tools / andere sprachen / oberonv4 / oberon-src / system / pictureframes.mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1995-12-30  |  24.0 KB  |  652 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10b.Scn.Fnt
  3. MODULE PictureFrames;    (* << RC *)
  4. IMPORT
  5.     Display, Oberon, Viewers, MenuViewers, Pictures, TextFrames, Input, Files, Texts, Fonts, SYSTEM;
  6. CONST
  7.     black = Pictures.black; white = Pictures.white;    ML = 2;    MM = 1;    MR = 0; CR = 0DX;    TAB = 09X;
  8. CONST redraw* = 0; resize* = 1;
  9.     UpdateMsg* = RECORD
  10.         (Display.FrameMsg)
  11.         id* : INTEGER;
  12.         pict* : Pictures.Picture;
  13.         x*, y*, w*, h* : INTEGER
  14.     END;
  15.     CopyOverMsg* = RECORD (Display.FrameMsg)
  16.         pict*: Pictures.Picture;
  17.         x*, y*, w*, h* : INTEGER
  18.     END;
  19.     Location* = POINTER TO LocDesc;
  20.     LocDesc* = RECORD
  21.         x*, y* : INTEGER;
  22.         next* : Location
  23.     END;
  24.     Frame* = POINTER TO FrameDesc;
  25.     FrameDesc* = RECORD
  26.         (Display.FrameDesc);
  27.         l*, t* : INTEGER; (* left, top of pict *)
  28.         pict* : Pictures.Picture;
  29.         car*, sel*, zoom* : INTEGER;
  30.         time* : LONGINT;
  31.         caret* : Location;
  32.         selx*, sely*, selw*, selh* : INTEGER;
  33.         string : RECORD
  34.              len, x, y  : INTEGER
  35.         END
  36.     END;
  37.     SelectionMsg = RECORD
  38.         (Display.FrameMsg)
  39.         time : LONGINT;
  40.         pict : Pictures.Picture;
  41.         x, y, w, h : INTEGER
  42.     END;
  43.     Pattern = ARRAY 9 OF LONGINT;
  44.     lineWidth*,grid*,color* : INTEGER;
  45.     smooth : BOOLEAN;
  46.     menuString* : ARRAY 100 OF CHAR;
  47.     cancel : SET;
  48.     resizePicture : Pictures.Picture;
  49.     F  : Frame;
  50. PROCEDURE max (i, j: INTEGER): INTEGER; BEGIN IF i >= j THEN RETURN i ELSE RETURN j END END max;
  51. PROCEDURE min (i, j: LONGINT): INTEGER; BEGIN  IF i >= j THEN RETURN SHORT(j) ELSE RETURN SHORT(i) END END min;
  52. PROCEDURE SetToDisplay(F : Frame;  VAR DX, DY : INTEGER);
  53.     VAR R : INTEGER;
  54. BEGIN
  55.     R := F.zoom DIV 2;
  56.     DX := (DX - 1 + R) DIV F.zoom * F.zoom + 1; DY := (DY -1 + R) DIV F.zoom * F.zoom +1
  57. END SetToDisplay;
  58. PROCEDURE Loc*(F : Frame; X,Y: INTEGER; VAR DX,DY : INTEGER);
  59.     (* Yp = (Yf - F.Y) - (F.H - F.t); *)
  60. BEGIN
  61.     DX := F.X + (X - F.l) * F.zoom; DY := F.Y + F.H + (Y - F.t) * F.zoom;
  62.     SetToDisplay(F,DX,DY)
  63. END Loc;
  64. PROCEDURE Pos*(F : Frame; DX,DY: INTEGER; VAR X, Y : INTEGER);
  65.     (* Yp = (Yf - F.Y) - (F.H - F.t); *)
  66.         VAR R : INTEGER;
  67. BEGIN
  68.     R := F.zoom DIV 2;
  69.     X := (DX - F.X - R-1) DIV F.zoom + F.l+1; Y := (DY - F.Y - F.H - R - 1 ) DIV F.zoom + F.t  + 1
  70. END Pos;
  71. PROCEDURE SetToGrid(F : Frame; VAR X,Y : INTEGER);
  72. BEGIN
  73.     X := (X + grid DIV 2) DIV grid * grid; Y := (Y + grid DIV 2) DIV grid * grid
  74. END SetToGrid;
  75. PROCEDURE SetToDGrid(F: Frame; VAR DX,DY : INTEGER);
  76.     VAR x,y : INTEGER;
  77. BEGIN
  78.     Pos(F,DX,DY,x,y); SetToGrid(F,x,y); Loc(F,x,y,DX,DY)
  79. END SetToDGrid;
  80. PROCEDURE DrawCaret(F : Frame; X, Y : INTEGER);
  81.     CONST C = 5;
  82.     VAR DX, DY, W : INTEGER;
  83. BEGIN
  84.     Loc(F,X,Y,DX,DY); DX := DX - C; DY := DY - C;  W := 2*C +1;
  85.     IF (DX > F.X) & (DY > F.Y) & (DX + W < F.X + F.W) & (DY + W < F.Y + F.H) THEN
  86.         Display.ReplConst(white,DX,DY+C,W,1,Display.invert);
  87.         Display.ReplConst(white,DX+C,DY,1,W,Display.invert)
  88. END DrawCaret;
  89. PROCEDURE SetCaret*(F : Frame; X, Y : INTEGER);
  90. (** set caret in frame F *)
  91.     VAR c : Location;
  92. BEGIN
  93.     INC(F.car);
  94.     NEW(c); c.x := X; c.y :=Y; c.next := F.caret; F.caret := c;
  95.     DrawCaret(F,X,Y)
  96. END SetCaret;
  97. PROCEDURE ClipPicture(P : Pictures.Picture; VAR X,Y,W,H : INTEGER);
  98.     VAR R,T : INTEGER;
  99. BEGIN
  100.     R := X + W; T := Y + H;
  101.     X := max(0,X); Y := max(0,Y); W := min(P.width,R) - X ; H := min(P.height,T) - Y
  102. END ClipPicture;
  103. PROCEDURE CopyOver*(F : Frame; picture : Pictures.Picture; X, Y, W, H : INTEGER);
  104.     VAR DX,DY :INTEGER;
  105. BEGIN
  106.     IF F.car > 0 THEN
  107.         ClipPicture(F.pict,F.caret.x,F.caret.y,W,H);
  108.         IF (W>0) & (H > 0) THEN
  109.             Pictures.CopyBlock(picture,F.pict,X,Y,W,H,F.caret.x,F.caret.y,Display.replace);
  110.             Pictures.Update(F.pict,F.caret.x,F.caret.y,W,H)
  111.         END
  112. END CopyOver;
  113. PROCEDURE Defocus*(F : Frame);
  114.     VAR c : Location;
  115. BEGIN
  116.     c := F.caret;
  117.     WHILE c # NIL DO DrawCaret(F,c.x,c.y); c := c.next END;
  118.     F.caret := NIL; F.car := 0
  119. END Defocus;
  120. PROCEDURE ClipFrame(F : Frame; VAR X, Y , W, H, DX, DY : INTEGER);
  121.     VAR R, T, dX,dY : INTEGER;
  122. BEGIN
  123.     Loc(F,X,Y,dX,dY);
  124.     DX := max(dX,F.X); DY := max(F.Y,dY);
  125.     SetToDisplay(F,DX , DY ); SetToDisplay(F,dX , dY );
  126.     Pos(F,DX,DY,X,Y);
  127.     W := (min(dX + W * F.zoom, F.X+ F.W) - DX) DIV F.zoom; H := (min(dY+ H * F.zoom,F.Y + F.H) - DY) DIV F.zoom;
  128.     IF DY < F.Y THEN INC(DY,8); INC(Y); DEC(H) END;
  129.     IF DX + W*F.zoom > F.X + F.W THEN DEC(W) END
  130. END ClipFrame;
  131. PROCEDURE ReplConst (F : Frame; col, X, Y, W, H, mode: INTEGER);
  132.     VAR D : INTEGER;
  133. BEGIN
  134.     IF X < F.X THEN DEC(W,F.X - X); X := F.X END; D :=  X + W - F.X - F.W; IF D >  0 THEN DEC(W,D)END;
  135.     IF Y < F.Y THEN DEC(H,F.Y - Y); Y := F.Y END; D := Y + H - F.Y - F.H; IF D > 0 THEN DEC(H,D) END;
  136.     IF (W > 0) & (H > 0) THEN
  137.         Display.ReplConst(col, X, Y, W, H, mode)
  138. END ReplConst;
  139. PROCEDURE Rectangle(F : Frame; DX,DY,W,H : INTEGER);
  140. BEGIN
  141.     ReplConst(F,white,DX,DY,W,1,Display.invert); (* bottom *)
  142.     ReplConst(F,white,DX+W,DY,1,H,Display.invert); (* right *)
  143.     IF H > 0 THEN ReplConst(F,white,DX+1,DY+H, W,1,Display.invert)END;(* top *)
  144.     IF W > 0 THEN ReplConst(F,white,DX,DY+1,1,H,Display.invert) END(* left *)
  145. END Rectangle;
  146. PROCEDURE RemoveSelection*(F : Frame);
  147. (** remove selection from frame F *)
  148.     VAR DX, DY :  INTEGER;
  149. BEGIN
  150.     IF F.sel # 0 THEN
  151.         Loc(F,F.selx,F.sely,DX,DY); Rectangle(F,DX,DY,F.selw *F.zoom,F.selh*F.zoom); F.sel := 0
  152. END RemoveSelection;
  153. PROCEDURE SetSelection*(F : Frame; X, Y, W, H : INTEGER);
  154. (** set (change) selection  in frame F *)
  155.     VAR DX,DY : INTEGER;
  156. BEGIN
  157.     RemoveSelection(F);
  158.     IF W > 0  THEN F.selx := X; F.selw := W  ELSE F.selx := X + W; F.selw := - W  END;
  159.     IF H > 0  THEN F.sely := Y; F.selh := H  ELSE F.sely := Y + H; F.selh := - H  END;
  160.     Loc(F,F.selx,F.sely,DX,DY); Rectangle(F,DX,DY,F.selw*F.zoom, F.selh* F.zoom);
  161.     F.time := Oberon.Time(); F.sel := 1
  162. END SetSelection;
  163. PROCEDURE TrackRect(F : Frame; VAR mX, mY : INTEGER;VAR mkeys : SET;  VAR x, y, w, h : INTEGER);
  164.     VAR X, Y, dX, dY,DX,DY, W, H : INTEGER; keys,M: SET;
  165. BEGIN
  166.     Pos(F,mX,mY,X, Y); dX := X - x; dY := Y - y; M := mkeys;
  167.     REPEAT
  168.         W := w; H := h; ClipFrame(F,x, y, W, H,DX,DY); Rectangle(F,DX, DY, W* F.zoom, H*F.zoom);
  169.         X := mX; Y := mY; keys := mkeys;
  170.         WHILE  (mX = X) & (Y = mY) & (keys = mkeys) DO
  171.             Input.Mouse(mkeys, mX, mY); Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, mX, mY)
  172.         END;
  173.         M := M + mkeys;
  174.         Rectangle(F,DX, DY, W* F.zoom, H*F.zoom);
  175.         Pos(F,mX,mY, X, Y); x := X -dX; y := Y -dY
  176.     UNTIL mkeys = {};
  177.     mkeys := M
  178. END TrackRect;
  179. PROCEDURE TrackSelection*(F : Frame; DX, DY : INTEGER; VAR keys : SET) ;
  180.     (** tracks selection in Frame F *)
  181.     VAR  M, k : SET; x0, y0,x, y, u,v,X, Y : INTEGER; t: INTEGER;
  182. BEGIN
  183.     Pos(F,DX,DY,X,Y); SetToGrid(F,X,Y); x0 := DX; y0 := DY; x := x0; y := y0; k := keys; M := keys;
  184.     WHILE keys # {} DO
  185.         REPEAT
  186.             Input.Mouse(k, u, v); Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, u, v)
  187.         UNTIL (x # u) OR (y # v) OR (k # keys);
  188.         RemoveSelection(F);
  189.         t := min(F.Y+F.H-1,max(F.Y,v));
  190.         Pos(F,min(F.X + F.W -1,max(F.X,u)),t,x,y); SetToGrid(F,x,y);
  191.         SetSelection(F,X,Y,x-X,y-Y);
  192.         x := u; y := v; keys := k; M := M + keys
  193.     END;
  194.     keys := M
  195. END TrackSelection;
  196. PROCEDURE GraphicSelection(VAR G : Graphics.Graph; VAR time : LONGINT);
  197.     VAR GF : Graphics.Frame; F : Display.Frame;
  198. BEGIN
  199.     F := Oberon.MarkedViewer();
  200.     IF F IS Graphics.Frame THEN
  201.         GF := F(Graphics.Frame); G := GF.graph; time := Oberon.Time()
  202.     ELSE
  203.         time := 0
  204. END GraphicSelection;
  205. PROCEDURE CopyGraph(G : Graphics.Graph; F : Frame);
  206.     VAR GF : Graphics.Frame;
  207. BEGIN
  208.     NEW(GF); GF.X := F.X; GF.Y := F.Y; GF.W := F.W; GF.H := F.H;
  209.     GF.X1 := GF.X + GF.W; GF.Y1 := GF.Y + GF.H;
  210.     GF.x := GF.X - GF.Xg; GF.y := GF.Y - GF.Yg
  211. END CopyGraph;
  212. PROCEDURE GetSelection*(VAR P : Pictures.Picture; VAR time : LONGINT; VAR x, y, w, h : INTEGER);
  213. (** get most recent selection.  *)
  214.     VAR i : INTEGER; msg : SelectionMsg;
  215. BEGIN
  216.     msg.time :=  -1; msg.pict := NIL;
  217.     Viewers.Broadcast(msg);
  218.     P := msg.pict; time := msg.time; x := msg.x; y := msg.y; w := msg.w; h := msg.h;
  219.     IF time > 0 THEN ClipPicture(P,x,y,w,h) END
  220. END GetSelection;
  221. PROCEDURE Neutralize* (F: Frame);
  222.     (** neutralize viewer V *)
  223.         VAR cMsg : Oberon.InputMsg;
  224. BEGIN
  225.     Oberon.RemoveMarks(F.X, F.Y, F.W, F.H);
  226.     Defocus(F);
  227.     RemoveSelection(F)
  228. END Neutralize;
  229. PROCEDURE RestoreBack(F : Frame; X, Y, W, H : INTEGER);
  230.     VAR DX,DY, B, H0 , fB, fT, fL, fR : INTEGER;
  231. BEGIN
  232.     Neutralize(F);
  233.     (*    Oberon.FadeCursor(Oberon.Mouse); *)
  234.     ClipPicture(F.pict,X,Y,W,H);
  235.     ClipFrame(F,X,Y,W,H,DX,DY);
  236.     H0 := min((F.pict.height - Y) * F.zoom,F.Y + F.H - DY);
  237.     Loc(F,0,F.pict.height,L,T);  H0 :=  min(T,F.Y + F.H) - DY;
  238.     IF (H0 <= 0) OR (W <= 0) THEN
  239.         Display.ReplConst(black,F.X,F.Y, F.W, F.H, Display.replace)
  240.     ELSIF (H >0) & (W > 0) THEN
  241.         (* draw frame *)
  242.         (* bottom *) IF Y = 0 THEN ReplConst(F,white,DX-1,DY-1,W * F.zoom+2,1,Display.replace); fB := 1 ELSE fB := 0 END;
  243.         (* left *) IF X = 0 THEN ReplConst(F,white,DX-1,DY,1,H*F.zoom,Display.replace); fL := 1 ELSE fL := 0 END;
  244.         (* top *) IF Y + H0 DIV F.zoom = F.pict.height  THEN ReplConst(F,white,DX-1,DY + H0,W * F.zoom+2, 1, Display.replace); fT := 1 ELSE fT := 0 END;
  245.         (* right *) IF  X + W = F.pict.width THEN ReplConst(F,white,DX + W * F.zoom, DY, 1, H *F.zoom, Display.replace); fR := 1 ELSE fR := 0  END;
  246.         (* bottom *) ReplConst(F,black,F.X,F.Y,F.W,DY-F.Y-fB,Display.replace);
  247.         (* top *) ReplConst(F,black,F.X,DY + H0 + fT,F.W,F.Y + F.H  - (DY + H0) - fT,Display.replace);
  248.         (* left *) ReplConst(F,black,F.X,DY-1,DX - F.X-fL,H*F.zoom + 2  ,Display.replace);
  249.         (* right *) ReplConst(F,black,DX + W*F.zoom+fR,DY - 1,F.X + F.W - (DX + W*F.zoom)-fR,H*F.zoom+ 2,Display.replace);
  250.         IF F.zoom # 1 THEN
  251.             H0 := (F.H + F.Y - DY) DIV F.zoom * F.zoom;
  252.             ReplConst(F,black,F.X,DY + H0 + fT, F.W, F.Y + F.H  - (DY + H0) - fT, Display.replace)
  253.         END
  254. END RestoreBack;
  255. PROCEDURE DisplayBlock(F : Frame; X, Y, W, H, DX, DY : INTEGER);
  256.     VAR x, y : INTEGER; P : Pictures.Picture;
  257. BEGIN y := 0; P := F.pict;
  258.     Display.ReplConst(black,DX,DY,W*8,H*8,Display.replace);
  259.     WHILE y < H DO x := 0;
  260.         WHILE x < W DO
  261.             Display.ReplConst( Pictures.Get(P,X + x,Y + y),DX + x * 8 , DY + y * 8,7, 7,Display.replace);
  262.             INC(x)
  263.         END;
  264.         INC(y)
  265. END DisplayBlock;
  266. PROCEDURE RestorePicture(F : Frame; X, Y, W, H : INTEGER);
  267.     VAR DX, DY ,Z : INTEGER;
  268. BEGIN
  269.     Neutralize(F);
  270.     (*     Oberon.FadeCursor(Oberon.Mouse); *)
  271.     ClipPicture(F.pict,X,Y,W,H);
  272.     ClipFrame(F,X,Y,W,H,DX,DY);
  273.     IF (H > 0) & (W > 0) THEN
  274.         IF F.zoom = 1 THEN
  275.             Pictures.DisplayBlock(F.pict,X, Y, W, H, DX, DY, Display.replace)
  276.         ELSE
  277.             SetToDisplay(F,DX,DY);
  278.             DisplayBlock(F,X, Y, W, H, DX, DY)
  279.         END
  280. END RestorePicture;
  281. PROCEDURE Restore*(F : Frame);
  282. BEGIN
  283.     Neutralize(F);
  284.     RestorePicture(F,0,0,F.pict.width,F.pict.height);
  285.     RestoreBack(F,0,0,F.pict.width,F.pict.height)
  286. END Restore;
  287. PROCEDURE NotifyDisplay*(P : Pictures.Picture; X,Y,W,H : INTEGER);
  288.     VAR msg : UpdateMsg;
  289. BEGIN
  290.     msg.x := X; msg.y := Y; msg.w := W;msg.h := H; msg.id := redraw; msg.pict := P;
  291.     Viewers.Broadcast(msg)
  292. END NotifyDisplay;
  293. PROCEDURE ResizePicture(F: Frame; P : Pictures.Picture; x, y : INTEGER);
  294. BEGIN
  295.     F.sel :=  0;
  296.     Neutralize(F);
  297.     F.pict := resizePicture;
  298.     DEC(F.l,x);  DEC(F.t, y);
  299.     Restore(F)
  300. END ResizePicture;
  301. PROCEDURE Resize*(F : Frame; X, Y, W, H : INTEGER);
  302.     VAR P : Pictures.Picture; msg : UpdateMsg;
  303. BEGIN
  304.     NEW(P); Pictures.Create(P,F.selw,F.selh,F.pict.depth); P.notify := NotifyDisplay;
  305.     Pictures.CopyBlock(F.pict,P,X,Y,W,H,X-F.selx,Y-F.sely,Display.replace);
  306.     resizePicture := P;
  307.     msg.pict := F.pict;  msg.x := F.selx; msg.y := F.sely; msg.id := resize;
  308.     Viewers.Broadcast(msg)
  309. END Resize;
  310. PROCEDURE Write*(F : Frame; font : Fonts.Font; col : INTEGER; ch : CHAR; VAR x, y : INTEGER; mode : INTEGER);
  311. (**  write ch at position x, y; after write x,y points to new position; CR(=0DX) is processed  *)
  312.     VAR pat: Display.Pattern; dx,u,v,w,h: INTEGER; P : Pictures.Picture;
  313. BEGIN
  314.     P := F.pict;
  315.     IF  (x # F.string.x) OR (y # F.string.y)  THEN  F.string.len := 0 END;
  316.     dx := 0;
  317.     IF ch = CR THEN
  318.         y := y  - font.height; x := x - F.string.len; F.string.len := 0
  319.     ELSIF  (ch >= " ")  OR (ch = TAB)  THEN
  320.         Display.GetChar(font.raster,ch,dx,u,v,w,h,pat);
  321.         IF (x >= 0) & (x + w < P.width) & (y >= 0) & (y +h < P.height) (*& (P.depth =1 )*) THEN
  322.             Pictures.CopyPattern(P,col,pat,x + u, y + v, mode)
  323.         END
  324.     END;
  325.     x := x + dx;
  326.     INC(F.string.len,dx); F.string.x := x; F.string.y := y
  327. END Write;
  328. PROCEDURE Line(F : Frame; col, x1, y1, x2, y2, mode : INTEGER; disp, first : BOOLEAN);
  329.     x, y, d, dx,dy, incx, incy, DX, DY  : INTEGER;  P : Pictures.Picture;
  330.     PROCEDURE Dot;
  331.     BEGIN
  332.         IF disp THEN
  333.             Loc(F,x,y,DX,DY);
  334.             IF (DX >= F.X) & (DY >= F.Y) & (DX  < F.X + F.W) & (DY < F.Y + F.H) THEN
  335.                 IF F. zoom = 1 THEN
  336.                     Display.ReplConst(col,DX,DY,1,1,mode)
  337.                 ELSE
  338.                     ReplConst(F,col,DX,DY,F.zoom-1,F.zoom-1,mode)
  339.                 END
  340.             END
  341.         ELSE
  342.             IF (x >= 0) & (y >= 0) & (x + lineWidth <= P.width) & (y +  lineWidth <= P.height) THEN
  343.                 Pictures.ReplConst(P,col,x,y,lineWidth,lineWidth,mode)
  344.             END
  345.         END
  346.     END Dot;
  347. BEGIN
  348.     P := F.pict;
  349.     x := x1; y := y1; dx := (x2-x1)*2; dy := (y2-y1)*2;
  350.     IF first THEN Dot END;
  351.     incx := 0;
  352.     IF dx < 0 THEN incx := -1; dx := -dx ELSIF dx>0 THEN incx := 1 END;
  353.     incy := 0;
  354.     IF dy < 0 THEN incy := -1; dy := -dy ELSIF dy>0 THEN incy := 1 END;
  355.     d := incx*(x1-x2);
  356.     IF dx>dy THEN
  357.         WHILE x#x2 DO INC(x, incx); INC(d, dy);
  358.             IF d>0 THEN INC(y, incy); DEC(d, dx) END;
  359.             Dot
  360.         END
  361.     ELSE
  362.         WHILE y#y2 DO INC(y, incy); INC(d, dx);
  363.             IF d>0 THEN INC(x, incx); DEC(d, dy) END;
  364.             Dot
  365.         END
  366. END Line;
  367. PROCEDURE WriteText*(F : Frame; X,Y : INTEGER; text : Texts.Text; beg, end : LONGINT);
  368.     VAR R : Texts.Reader; ch : CHAR;
  369. BEGIN
  370.     Texts.OpenReader(R,text,beg); Texts.Read(R,ch);
  371.     WHILE beg < end DO
  372.         Write(F,R.fnt,R.col, ch, X, Y, Display.paint);    (* << RC *)
  373.         Texts.Read(R,ch); INC(beg)
  374.     END;
  375.     Pictures.Update(F.pict,0,0,F.pict.width,F.pict.height);
  376.     SetCaret(F,X,Y)
  377. END WriteText;
  378. PROCEDURE Modify* (F: Frame; id, dY, Y, H: INTEGER);
  379.     VAR V : Viewers.Viewer;  dH,X : INTEGER;
  380. BEGIN
  381.     dH := H - F.H;
  382.     IF F.H = 0 THEN
  383.         F.Y := Y; F.H := H; Display.ReplConst(black,F.X,F.Y,F.W,F.H,Display.replace);
  384.         Restore(F)
  385.     ELSE
  386.         F.Y := Y; F.H := H;
  387.         IF F.zoom # 1 THEN
  388.             IF id = MenuViewers.extend THEN ReplConst(F,black, F.X, F.Y + F.H - dY, F.W, dY, Display.replace) END;
  389.             Pos(F,F.X,F.Y,X,Y);
  390.             RestorePicture(F,0,Y,F.pict.width*8,F.pict.height*8); RestoreBack(F,0,Y,F.pict.width,F.H)
  391.         ELSE
  392.             IF id = MenuViewers.extend THEN
  393.                 IF (dY # 0) & (F.zoom = 1) THEN
  394.                     Display.CopyBlock(F.X,Y,F.W,H-dY,F.X,Y+dY, Display.replace);
  395.                     Display.ReplConst(black,F.X,Y,F.W,dY,Display.replace)
  396.                 END;
  397.                 Pos(F,F.X,F.Y,X,Y);
  398.                 RestorePicture(F,0,Y,F.pict.width,dH); RestoreBack(F,0,Y,F.pict.width,dH)
  399.             ELSIF id = MenuViewers.reduce THEN
  400.                 IF H # 0 THEN
  401.                     IF dY # 0 THEN
  402.                         Display.CopyBlock(F.X,Y+dY,F.W,H,F.X,Y, Display.replace)
  403.                     END
  404.                 END
  405.             END
  406.         END
  407. END Modify;
  408. PROCEDURE Copy*(F : Frame; VAR F1 : Frame);
  409. BEGIN
  410.     Neutralize(F);
  411.     NEW(F1); F1^ := F^; F1.H := 0
  412. END Copy;
  413. PROCEDURE TrackMouse(VAR keys : SET; VAR X,Y : INTEGER);
  414. BEGIN
  415.     REPEAT Input.Mouse(keys, X, Y); Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, X, Y) UNTIL keys = {}
  416. END TrackMouse;
  417. PROCEDURE TrackCopy(F : Frame; P : Pictures.Picture;  X, Y , W, H, X0, Y0, DX, DY, mode: INTEGER; VAR keys: SET);
  418.     VAR x, y, u, v , x0, y0,  deltaX, deltaY : INTEGER; k ,M: SET; B, B0 : Pictures.Picture; wth : INTEGER;
  419.     PROCEDURE CopyBlock(S, D : Pictures.Picture; X, Y , W, H, DX,DY : INTEGER);
  420.         PROCEDURE Clip(D  : Pictures.Picture; VAR X,Y,W,H,DX,DY : INTEGER);
  421.         BEGIN
  422.             IF DX < 0 THEN INC(W,DX); DEC(X,DX); DX := 0 END;
  423.             IF DY < 0  THEN INC(H,DY); DEC(Y,DY); DY := 0 END;
  424.             IF DX + W > D.width THEN  DEC(W,DX + W - D.width ) END;
  425.             IF DY + H > D.height THEN DEC(H, DY + H- D.height) END
  426.         END Clip;
  427.     BEGIN
  428.         Clip(D,X,Y,W,H,DX,DY);
  429.         Clip(S,DX,DY,W,H,X,Y);
  430.         IF (W > 0) & (H > 0) THEN
  431.             Pictures.CopyBlock(S,D,X, Y , W, H, DX,DY,Display.replace)
  432.         END
  433.     END CopyBlock;
  434. BEGIN
  435.     IF (W > 0) & (H > 0)  THEN
  436.         SetToDGrid(F,DX,DY); Pos(F,DX,DY,x0,y0);  deltaX := X0 - x0; deltaY := Y0 - y0;
  437.         x := DX; y := DY; k := keys; M := keys;
  438.         IF ~ smooth OR (F.zoom # 1) THEN
  439.             RemoveSelection(F);
  440.             u := X0; v := Y0;
  441.             TrackRect(F,DX,DY,keys,u, v,W, H);
  442.             IF keys # cancel THEN
  443.                 IF mode = Display.replace THEN
  444.                     NEW(B0); Pictures.Create(B0,W,H,P.depth); CopyBlock(F.pict,B0,X,Y,W,H,0,0);
  445.                     Pictures.ReplConst(F.pict,black,X0,Y0,W,H,Display.replace);
  446.                     CopyBlock(B0,F.pict,0,0,W,H,u,v)
  447.                 ELSE
  448.                     CopyBlock(P,F.pict, X, Y, W, H, u,v)
  449.                 END
  450.             END
  451.         ELSE
  452.             NEW(B0); Pictures.Create(B0,W,H,P.depth); CopyBlock(F.pict,B0,X,Y,W,H,0,0);
  453.             NEW(B); Pictures.Create(B,W,H,P.depth);
  454.             IF mode = Display.replace THEN
  455.                 IF F.pict = P THEN P := B0; X := 0; Y := 0 END;
  456.                 Pictures.ReplConst(F.pict,black,X0,Y0,W,H,Display.replace)
  457.             END;
  458.             CopyBlock(F.pict,B,(x0 + (x-DX) + deltaX),y0 + (y-DY ) + deltaY,W,H, 0, 0); (* save *)
  459.             WHILE (keys # {}) & (M # cancel) DO
  460.                 REPEAT  Input.Mouse(k, u, v); SetToDGrid(F,u,v) UNTIL (u # x) OR (v # y) OR (k # keys);
  461.                 M := M + k;
  462.                 CopyBlock(B,F.pict,0,0,W,H,(x0 + (x-DX) DIV F.zoom + deltaX),y0 + (y-DY ) DIV F.zoom + deltaY); (* restore *)
  463.                 IF M # cancel THEN
  464.                     CopyBlock(F.pict,B,(x0 + (u-DX)  DIV F.zoom  + deltaX),y0 + (v-DY ) DIV F.zoom  + deltaY,W,H, 0, 0); (* save *)
  465.                     CopyBlock(P,F.pict,X,Y,W,H, x0 + (u-DX) DIV F.zoom  + deltaX,y0 + (v-DY ) DIV F.zoom  + deltaY); (* new *)
  466.                     RestorePicture(F,0,0,F.pict.width,F.pict.height)
  467.                 ELSE
  468.                     IF mode # Display.paint THEN
  469.                         CopyBlock(B0,F.pict,0,0,W,H,X0,Y0)
  470.                     END
  471.                 END;
  472.                 x := u; y := v; keys := k;
  473.                 Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y)
  474.             END
  475.         END;
  476.         Pictures.Update(F.pict,0,0,F.pict.width,F.pict.height)
  477.     END;
  478.     TrackMouse(keys,X,Y); keys := M
  479. END TrackCopy;
  480. PROCEDURE Edit*(F : Frame;  X, Y: INTEGER; keys: SET);
  481.     VAR x, y, u, v , x0, y0, w, h, l, t : INTEGER; M,k : SET; beg,end, time, time2 : LONGINT; P : Pictures.Picture; cMsg : CopyOverMsg;
  482.         text : Texts.Text; line, ln : Location;
  483. BEGIN
  484.     IF keys = {ML} THEN
  485.         x := X; y := Y;
  486.         REPEAT
  487.             Input.Mouse(k, u, v);
  488.             Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, u, v)
  489.         UNTIL (ABS(u-X) > 4) OR (ABS(v -Y) > 4) OR (k # {ML});
  490.         keys := k;
  491.         IF (keys = {}) OR ((keys = {ML,MR}) & (F.car # 0)) THEN
  492.             IF  (F.car = 0) (*Viewers.This(F.X,F.Y) # Oberon.FocusViewer*) OR (keys = {})  THEN Oberon.PassFocus(Viewers.This(u,v)) END;
  493.             REPEAT
  494.                 WHILE (keys # {}) & (keys # {ML}) DO Input.Mouse(keys, u, v); Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, u, v) END;
  495.                 Pos(F,u,v,X,Y); SetToGrid(F,X,Y); SetCaret(F,X,Y);
  496.                 WHILE keys = {ML} DO Input.Mouse(keys, u, v); Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, u, v) END
  497.             UNTIL keys = {}
  498.         ELSIF keys = {ML,MM} THEN
  499.             GetSelection(P,time,x,y,w,h);
  500.             Oberon.GetSelection(text, beg, end, time2);
  501.             IF (time > time2) & (time > 0) THEN
  502.                 Pos(F,X,Y,u,v); SetToGrid(F,u,v); keys := {ML};
  503.                 TrackCopy(F,P,x,y,w,h,u,v,X,Y,Display.paint,keys)
  504.             ELSIF time2 > 0 THEN
  505.                 Pos(F,u,v,X,Y); SetCaret(F,X,Y);
  506.                 WriteText(F,X,Y,text,beg,end);
  507.                 TrackMouse(keys,X,Y)
  508.             END
  509.         ELSIF keys # {} THEN
  510.             Pos(F,x,y,x0,y0); SetToGrid(F,x0,y0); M := keys; keys := {};
  511.             NEW(line); line.x := x0; line.y := y0;
  512.             Line(F,Display.white,x0,y0,x0,y0,Display.invert,TRUE,TRUE);
  513.             REPEAT
  514.                 Pos(F,u,v,X,Y); SetToGrid(F,X,Y);
  515.                 Line(F,Display.white,x0,y0,X,Y,Display.invert,TRUE,FALSE);
  516.                 x := u; y := v;
  517.                 REPEAT
  518.                     Input.Mouse(k, u, v); Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, u, v)
  519.                 UNTIL (keys # k) OR (x # u) OR (y # v);
  520.                 M := M + k; keys := k;
  521.                 IF keys = {ML,MR} THEN
  522.                     NEW(ln); ln.next:= line; line := ln;
  523.                     ln.x := X; ln.y := Y; x0 := X; y0 := Y
  524.                 ELSE
  525.                     Line(F,Display.white,x0,y0,X,Y,Display.invert,TRUE,FALSE)
  526.                 END
  527.             UNTIL keys = {};
  528.             IF M # cancel THEN
  529.                 ln := line;
  530.                 WHILE ln.next # NIL DO
  531.                     Line(F,color,ln.next.x,ln.next.y,ln.x,ln.y,Display.replace,FALSE,TRUE);
  532.                     ln := ln.next
  533.                 END
  534.             END;
  535.             Pictures.Update(F.pict,0,0,F.pict.width,F.pict.height);
  536.             RestoreBack(F,0,0,F.pict.width,F.pict.height)
  537.         END
  538.     ELSIF keys = {MM} THEN
  539.         Pos(F,X,Y,u,v);
  540.         IF (F.sel > 0) & (u > F.selx) & (v > F.sely) & (u <= F.selx + F.selw) & (v <= F.sely + F.selh) THEN
  541.             GetSelection(P,time,x,y,w,h);
  542.             TrackCopy(F,P,x,y,w,h,x,y,X,Y,Display.replace,keys)
  543.         ELSE
  544.             l := F.l; t := F.t; M := keys;
  545.             WHILE (keys # {}) & (M # cancel)DO
  546.                 REPEAT  Input.Mouse(k, u, v) UNTIL (u # x) OR (v # y) OR (k # keys);
  547.                 x := u; y := v; keys := k; M := M + keys;
  548.                 IF M = cancel THEN F.l := 0(* l *); F.t := F.pict.height (* t *) ELSE F.l:= l + (X - x) DIV F.zoom; F.t := t + (Y - y) DIV F.zoom END;
  549.                 IF smooth & (F.zoom = 1) THEN Restore(F) END;
  550.                 Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y)
  551.             END;
  552.             IF ~ smooth OR (F.zoom # 1) THEN Restore(F) END
  553.         END
  554.     ELSIF keys = {MR} THEN
  555.         TrackSelection(F,X,Y,keys);
  556.         GetSelection(P,time,x,y,w,h);
  557.         IF keys = {ML,MR} THEN
  558.             Pictures.ReplConst(F.pict,black,x, y, w,h, Display.replace); Pictures.Update(P,x,y,w,h)
  559.         ELSIF keys = {MM,MR} THEN
  560.             cMsg.x := x; cMsg.y := y;cMsg.w := w; cMsg.h := h; cMsg.pict := P;
  561.             Oberon.FocusViewer.handle(Oberon.FocusViewer,cMsg)
  562.         END
  563.     END;
  564.     TrackMouse(keys,X,Y)
  565. END Edit;
  566. PROCEDURE Handle*(F: Display.Frame; VAR msg: Display.FrameMsg);
  567.     VAR F1 : Frame; DX, DY, H0, X, Y, x, y, w, h, dx : INTEGER; p : LONGINT;
  568. BEGIN
  569.     WITH F : Frame DO
  570.         IF msg IS Oberon.ControlMsg THEN
  571.             WITH msg : Oberon.ControlMsg DO
  572.                 IF msg.id = Oberon.defocus THEN Defocus(F)
  573.                 ELSIF msg.id = Oberon.neutralize THEN Neutralize(F)
  574.                 ELSIF msg.id = Oberon.mark THEN Oberon.DrawCursor(Oberon.Pointer, Oberon.Star, msg.X, msg.Y)
  575.                 END
  576.             END
  577.         ELSIF msg IS Oberon.InputMsg THEN
  578.             WITH msg: Oberon.InputMsg DO
  579.                 IF msg.id = Oberon.consume THEN
  580.                     IF F.car > 0 THEN
  581.                         X := F.caret.x; Y :=  F.caret.y;
  582.                         Write(F,msg.fnt,color,msg.ch,X,Y, Display.paint);    (* << RC *)
  583.                         Display.GetChar(msg.fnt.raster,msg.ch,dx,x,y,w,h,p);
  584.                         Pictures.Update(F.pict,X+x-dx,Y+y,w,h);
  585.                         SetCaret(F,X,Y)
  586.                     END
  587.                 (* write *)
  588.                 ELSIF  msg.id = Oberon.track THEN
  589.                     IF msg.keys # {} THEN Edit(F,msg.X, msg.Y, msg.keys) ELSE
  590.                     Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, msg.X, msg.Y) END
  591.                 END
  592.             END
  593.         ELSIF msg IS Oberon.CopyMsg THEN
  594.             WITH msg : Oberon.CopyMsg DO
  595.                 Copy(F,F1); msg.F := F1
  596.             END
  597.         ELSIF msg IS MenuViewers.ModifyMsg THEN
  598.             Neutralize(F);
  599.             WITH msg : MenuViewers.ModifyMsg DO
  600.                 Modify(F, msg.id, msg.dY, msg.Y, msg.H)
  601.             END
  602.         ELSIF msg IS Oberon.CopyOverMsg THEN
  603.             WITH msg : Oberon.CopyOverMsg DO
  604.                 IF (F.car > 0) THEN
  605.                     WriteText(F,F.caret.x,F.caret.y,msg.text,msg.beg,msg.end)
  606.                 END
  607.             END
  608.         ELSIF msg IS CopyOverMsg THEN
  609.             WITH msg : CopyOverMsg DO
  610.                 CopyOver(F,msg.pict,msg.x,msg.y,msg.w,msg.h)
  611.             END
  612.         ELSIF msg IS SelectionMsg THEN
  613.             WITH msg : SelectionMsg DO
  614.                 IF (F.time > msg.time) & (F.sel > 0) THEN
  615.                     msg.pict := F.pict; msg.time := F.time; msg.x := F.selx; msg.y := F.sely; msg.w := F.selw; msg.h := F.selh
  616.                 END
  617.             END
  618.         ELSIF msg IS UpdateMsg THEN
  619.             WITH msg : UpdateMsg DO
  620.                 IF msg.pict = F.pict THEN
  621.                     IF msg.id= redraw THEN
  622.                         RestorePicture(F,msg.x,msg.y,msg.w,msg.h)
  623.                     ELSIF msg.id = resize THEN
  624.                         ResizePicture(F,msg.pict,msg.x,msg.y)
  625.                     END
  626.                 END
  627.             END
  628.         END
  629. END Handle;
  630. PROCEDURE Picture*(name : ARRAY OF CHAR) : Pictures.Picture;
  631.     VAR P : Pictures.Picture;
  632. BEGIN
  633.     NEW(P); Pictures.Open(P, name); P.notify := NotifyDisplay; RETURN P
  634. END Picture;
  635. PROCEDURE Open*(F : Frame;H: Display.Handler; P : Pictures.Picture; l, t : INTEGER);
  636. BEGIN
  637.     F.pict := P; F.t := t; F.l := l; F.car := 0; F.zoom := 1; F.sel := 0;
  638.     F.handle := H
  639. END Open;
  640. PROCEDURE NewPicture*(P : Pictures.Picture) : Frame;
  641.     VAR F : Frame;
  642. BEGIN
  643.     NEW(F); Open(F,Handle,P,0,P.height); P.notify := NotifyDisplay;
  644.     RETURN F
  645. END NewPicture;
  646. BEGIN
  647.     menuString := "System.Close  System.Copy  System.Grow  Paint.Zoom  Paint.Resize  Paint.Store";
  648.     cancel := {ML,MM,MR};
  649.     lineWidth := 1;grid := 1; color := Display.white;
  650.     smooth := TRUE
  651. END PictureFrames.
  652.